home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / tb_ontop / tbontop.bas < prev    next >
BASIC Source File  |  1994-07-14  |  5KB  |  128 lines
  1. Option Explicit
  2.  
  3.   ' CONSTANTS
  4.     '
  5.     ' Global Constants for Stay On Top call
  6.     '
  7.       Global Const SWP_NOMOVE = 2
  8.       Global Const SWP_NOSIZE = 1
  9.       Global Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
  10.       Global Const HWND_TOPMOST = -1
  11.       Global Const HWND_NOTOPMOST = -2
  12.     '
  13.     ' System Menu Constants
  14.     '
  15.       Global Const MF_SEPARATOR = &H800
  16.       Global Const MF_STRING = &H0
  17.       Global Const MF_ENABLED = 0
  18.       Global Const MF_BYCOMMAND = &H0
  19.       Global Const MF_UNCHECKED = &H0
  20.       Global Const MF_CHECKED = &H8
  21.       Global Const MF_BYPOSITION = &H400
  22.     '
  23.     ' Windows Message Constants
  24.     '
  25.       Global Const WM_QUERYOPEN = &H13    'restore minimized window message
  26.       Global Const WM_SYSCOMMAND = &H112  'system command message
  27.  
  28.   ' API CALLS
  29.     '
  30.     ' FindWindow API call to locate VB Toolbox
  31.     '
  32.       Declare Function FindWindowBystring Lib "User" Alias "FindWindow" (ByVal lpClassName As Any, ByVal lpWindowName As String) As Integer
  33.     '
  34.     ' SetWindowPos API call used to toggle window stay on top status
  35.     '
  36.       Declare Function SetWindowPos Lib "User" (ByVal h As Integer, ByVal hb As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal f As Integer) As Integer
  37.     '
  38.     ' System Menu API Declarations
  39.     '
  40.       '
  41.       ' Append or Remove menu items
  42.       '
  43.         Declare Function AppendMenu Lib "USER" (ByVal hMenu As Integer, ByVal wFlags As Integer, ByVal wIDNewItem As Integer, ByVal lpNewItem As Any) As Integer
  44.         Declare Function RemoveMenu Lib "USER" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer
  45.       '
  46.       ' Get System Menu handle
  47.       '
  48.         Declare Function GetSystemMenu Lib "USER" (ByVal hWnd As Integer, ByVal bRevert As Integer) As Integer
  49.       '
  50.       ' Get the state of and modify System Menu items. Used to check and
  51.       ' uncheck menu items
  52.       '
  53.         Declare Function GetMenuState Lib "USER" (ByVal hMenu As Integer, ByVal wId As Integer, ByVal wFlags As Integer) As Integer
  54.         Declare Function ModifyMenuBystring Lib "USER" Alias "ModifyMenu" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer, ByVal wIDNewItem As Integer, ByVal lpString As String) As Integer
  55.  
  56. Sub CheckOnTop (iStatus As Integer)
  57.   '
  58.   ' Place checkmark on or remove checkmark from hard coded menu item.
  59.   ' Routine could be made more generic by passing more info into it.
  60.   '
  61.   Dim iResult As Integer, hMenu As Integer
  62.   hMenu = GetSystemMenu(frmMain.hWnd, False)
  63.   If iStatus = MF_UNCHECKED Then
  64.     iResult = ModifyMenuBystring(hMenu, 6, MF_UNCHECKED Or MF_BYPOSITION, 1, "&Toolbox On Top")
  65.   Else
  66.     iResult = ModifyMenuBystring(hMenu, 6, MF_CHECKED Or MF_BYPOSITION, 1, "&Toolbox On Top")
  67.   End If
  68. End Sub
  69.  
  70. Function IsMenuChecked () As Integer
  71.  '
  72.  '  See if System Menu Item is checked or not
  73.  '
  74.  Dim iResult As Integer, hMenu As Integer
  75.  hMenu = GetSystemMenu(frmMain.hWnd, False)
  76.  iResult = GetMenuState(hMenu, 1, MF_BYCOMMAND)
  77.  If iResult = MF_CHECKED Then
  78.    IsMenuChecked = True
  79.  Else
  80.    IsMenuChecked = False
  81.  End If
  82. End Function
  83.  
  84. Sub SetupDialogMenu (frm As Form)
  85.   Dim hMenu As Integer, iResult As Integer
  86.   hMenu = GetSystemMenu(frm.hWnd, 0)
  87.   '
  88.   ' Remove all but the MOVE and CLOSE options. Note that
  89.   ' the min and max buttons are assumed to be set to
  90.   ' false and the form's BorderStyle is assumed to be
  91.   ' fixed double.
  92.   '
  93.   iResult = RemoveMenu(hMenu, 8, MF_BYPOSITION) 'Switch to
  94.   iResult = RemoveMenu(hMenu, 7, MF_BYPOSITION) 'Separator
  95.   iResult = RemoveMenu(hMenu, 5, MF_BYPOSITION) 'Separator
  96. End Sub
  97.  
  98. Sub SysMenuBuild ()
  99.  '
  100.  ' Add Additional Menu Strings to System Menu
  101.  '
  102.  Dim hMenu As Integer, Result As Integer
  103.  hMenu = GetSystemMenu(frmMain.hWnd, False)
  104.  Result = AppendMenu(hMenu, MF_SEPARATOR, 0, "")
  105.  Result = AppendMenu(hMenu, MF_STRING, 1, "&Toolbox On Top")
  106.  Result = AppendMenu(hMenu, MF_SEPARATOR, 0, "")
  107.  Result = AppendMenu(hMenu, MF_STRING, 2, "&About 'Toolbox On Top'...")
  108. End Sub
  109.  
  110. Sub ToolboxOnTop (iToggle As Integer)
  111.   Dim iResult As Integer, iToolbox As Integer
  112.   '
  113.   ' Gets VB Toolbox handle
  114.   '
  115.   iToolbox = FindWindowBystring("ToolsPalette", "")
  116.   '
  117.   ' If Toolbox is present, then toggle it
  118.   '
  119.   If iToolbox <> 0 Then
  120.     If iToggle Then
  121.       iResult = SetWindowPos(iToolbox, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
  122.     Else
  123.       iResult = SetWindowPos(iToolbox, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
  124.     End If
  125.   End If
  126. End Sub
  127.  
  128.